perm filename PRED4.FAI[SYS,HE]1 blob
sn#009297 filedate 1972-12-06 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
00005 00003 DYNAMIC FREE STORAGE ROUTINES.
00007 00004 RELEASE A BLOCK - RELBLK(E) - E/ SIZE,,0
00009 00005 BFEV MAKES AND KILLS.
00011 00006 DEFINE MKQ $(FACE,F){
00012 00007 BFEV KILL OPERATIONS.
00013 00008 SUBR KLBFEV
00014 00009 WING MAKE LINKS.
00016 00010 ORIENTED WING FETCH OPERATIONS.
00017 00011 ORIENTED WING FETCH OPERATIONS.
00019 00012 BODY FETCHER - GET THE BODY OF Q.
00021 00013 SUBR(MKLOCOR)
00022 00014 ATTACH B1 TO B2, B1 BECOMES A SUBPART OF B2.
00024 ENDMK
⊗;
TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
COMMENT / - 28 PRIMITIVES -
0. DYNAMIC FREE STORAGE...............................2 & 3.
ADDR ← GETBLK(SIZE);
RELBLK(ADDR);
1. BFEV MAKE & KILL OPERATIONS........................4 & 5.
BNEW ← MKB(B); KLB(BNEW);
FNEW ← MKF(B); KLF(B,FNEW);
ENEW ← MKE(B); KLE(B,ENEW);
VNEW ← MKV(B); KLV(B,VNEW);
BNEW ← MKBFV; KLBFEV(Q);
2. WING MAKE LINK OPERATIONS..............................6.
NCW.(Q,E); PCW.(Q,E);
NCCW.(Q,E); PCCW.(Q,E);
3. ORIENTED WING FETCH & STORE OPERATIONS.............7 & 8.
E ← ECW(E,Q); ECW.(Q,E,X);
E ← ECCW(E,Q); ECCW.(Q,E,X);
Q ← OTHER(E,Q); OTHER.(Q,E,X);
4. BFV FETCH OPERATIONS..............................9 & 10.
B ← BODY(Q); B0 ← MKPARTS(B0);
F ← FCW(E,V); F ← FCCW(E,V);
V ← VCW(E,F); V ← VCCW(E,F);
/
INTERN WORLD↔WORLD: 0
;DYNAMIC FREE STORAGE ROUTINES.
EXTERN CORGET;
NIL←777777
INTERN CORSIZ↔CORSIZ: 0
SAVP1: .+1
AVAIL: NIL
; ADDR ← GETBLK(SIZE);
SUBR GETBLK;(SIZE)
BEGIN GETBLK
ACCUMULATORS{PTR,SIZ,P1,P2,N}
; FETCH THE ARGUMENTS.
LAC N,ARG1↔ADDM N,CORSIZ
LAC P1,SAVP1
; SCAN AVAIL LIST.
L1: CDR P2,(P1);
CAIN P2,NIL;
; WHEN THERE'S NO ROOM, GET A BIG BLOCK FROM SAIL.
GO[NIM SIZ,=4090↔CALL CORGET
GO[FATAL(GETBLK)];
DIP SIZ,(PTR)
CALL RELBLK,PTR;
LIMZ P1,AVAIL↔LAC N,ARG1↔GO L1]
; IS THIS ONE BIG ENUF ?
CAR SIZ,(P2)
CAMGE SIZ,N
GO[LAC P1,P2↔GO L1]
; CARVE N WORDS OFF THE TOP.
SUB SIZ,N
JUMPE SIZ,[CDR(P2)↔DAP(P1)↔LIMZ P1,AVAIL↔GO L2];ALL USED UP.
DIP SIZ,(P2)
L2: ADD SIZ, P2
SETZM (SIZ)
RET1(SIZ)
LIT
BEND
;RELEASE A BLOCK - RELBLK(E) - E/ SIZE,,0
SUBR RELBLK;(ADDR)
BEGIN RELBLK
ACCUMULATORS{E,SIZ,P1,P2}
; FETCH ARGUMENTS AND CLEAR THE BLOCK.
CDR E,ARG1↔CAR SIZ,(E)
CAIGE SIZ,=4000↔GO[MOVNS SIZ↔ADDM SIZ,CORSIZ↔MOVNS SIZ↔GO .+1]
SETZM 1(E)↔CAIE SIZ,1↔GO[
LAC E↔SLAP E↔ADD [XWD 1,2]
LAC 1,SIZ↔ADD 1,E↔BLT -1(1)↔GO .+1]
; FIND BLOCK'S PLACE IN AVAIL.
LIMZ P1,AVAIL
L3: CDR P2,(P1)
CAMG P2,E
GO [LAC P1,P2↔ GO L3]
; TRY TO MERGE WITH THE BLOCK ABOVE.
LAC E↔ ADD SIZ↔ CAME P2;
GO [DAP P2,(E)↔ GO L4]; NO MERGE - SO ME POINT AT HIM.
; MERGE WITH BLOCK ABOVE.
CAR(P2)↔ADD SIZ,; ME BIGGER NOW.
CDR(P2)↔DAP (E) ; ME POINT WHERE HE POINTS.
SETZM(P2)
; TRY TO MERGE WITH THE BLOCK BELOW.
L4: CAR(P1)↔ADD P1↔CAME E;
GO[DAP E,(P1)↔DIP SIZ,(E)↔GO L5]
; MERGE WITH BLOCK BELOW.
CAR(P1)↔ADD SIZ↔DIP (P1); HIM BIGGER NOW.
CDR(E)↔DAP(P1); HIM POINT WHERE I POINT.
SETZM(E)
L5: RET1
LIT
BEND
; BFEV MAKES AND KILLS.
BEGIN MAKILL
INTERN BTOTAL,FTOTAL,ETOTAL,VTOTAL
BTOTAL: 0↔FTOTAL: 0↔ETOTAL: 0↔VTOTAL: 0
INTERN BSIZE,FSIZE,ESIZE,VSIZE
BSIZE: 4+6
FSIZE: 4+6
ESIZE: 4+12
VSIZE: 4+6
; BNEW ← MKB(B0)
SUBR(MKB)
BEGIN MKB
B←1 ↔ B0←2
CALL GETBLK,BSIZE
ADDI B,3 ↔ MARK B,BBIT
;ATTACH B TO B0, THAT IS B IS A SUB-PART OF B0.
LAC B0,ARG1↔PART 0,B0↔PART. B,B0↔AOS 5(B0);INCREM PCNT.
COPAR. 0,B↔LACN 0,B↔PART. 0,B; BNEW HAVE NO PARTS.
SLAP B,B↔FOR I←1,3<DAC B,I(B)↔>CDR B,B
EXCH 2 ↔ AOS 2,BTOTAL ↔ SERIA. 2,B ↔ EXCH 2
RET1
BEND
SUBR(MKBFV)
CALL MKB,WORLD
DAC 1,BNEW#
CALL MKF,BNEW
CALL MKV,BNEW
RET0(BNEW)
DEFINE MKQ $(FACE,F){
SUBR(MK$F)
BEGIN MK$F
Q←1 ↔ X←2 ↔ B←3
SAVAC(6)
CALL GETBLK,F$SIZE
ADDI 1,3
CAR(1)↔SKIPE↔BUG: HALT
MARK 1,F$BIT
AOS F$TOTAL
LAC B,ARG1
F$CNT 0,B↔AOS↔F$CNT. 0,B
N$FACE X,B
P$FACE$. Q,X
N$FACE$. Q,B
P$FACE$. B,Q
N$FACE$. X,Q
IFIDN<E><F><PBODY. B,Q>
SETZ↔CAME X,B↔SERIAL 0,X↔AOS↔SERIA. 0,Q
GETAC(6)
RET1
BEND}
MKQ(FACE,F)
MKQ(ED,E)
MKQ(VT,V)
;BFEV KILL OPERATIONS.
SUBR(KLB)
BEGIN KLB
B←1
LAC B,ARG1
SUBI B,3
LAC BSIZE
DIPZ (B)
CALL RELBLK,B
SOS BTOTAL
RET1
BEND
DEFINE KLQ $(FACE,F){
SUBR(KL$F)
BEGIN KL$F
X←2 ↔ Y←B←3
SAVAC(6)
LAC 1,ARG1
N$FACE X,1
P$FACE Y,1
N$FACE$. X,Y
P$FACE$. Y,X
SUBI 1,3
LAC F$SIZE
DIPZ (1)
CALL RELBLK,1
SOS F$TOTAL
LAC B,ARG2
F$CNT 0,B↔SOS↔F$CNT. 0,B
GETAC(6)
RET2
BEND}
KLQ(FACE,F);
KLQ(ED,E);
KLQ(VT,V);
BEND
SUBR KLBFEV
BEGIN KLBFEV
ACCUMULATORS{B,F,E,V}
LAC B,ARG1
SETQ(B,{BODY,B})
L1: PFACE F,B↔TESTZ F,FBIT↔GO[CALL KLF,B,F↔GO L1]
L2: PED E,B↔TESTZ E,EBIT↔GO[CALL KLE,B,E↔GO L2]
L3: PVT V,B↔TESTZ V,VBIT↔GO[CALL KLV,B,V↔GO L3]
CALL KLB,B
RET1
BEND
;WING MAKE LINKS.
; NCW.(Q,E);
; PCW.(Q,E);
; NCCW.(Q,E);
; PCCW.(Q,E);
DEFINE WING. $(NAME,N,M,P,DIP,DAP) {
SUBR(NAME)
BEGIN NAME
Q←5↔E←6
SAVAC(6)
CDR Q,ARG2
CDR E,ARG1
NAME$. Q,E
N$FACE 1,E↔M$VT 2,E
N$FACE 3,Q↔P$VT 4,Q
CAME 1,3↔ GO[P$FACE 3,Q↔GO L2]
CAME 2,4↔ GO[N$VT 4,Q↔GO L1]↔ DIP E,5(Q)↔GO L
L1: CAME 2,4↔ GO DIE↔ DIP E,4(Q)↔GO L
L2: CAME 1,3↔ GO DIE
CAME 2,4↔ GO[N$VT 4,Q↔GO L3]↔ DAP E,4(Q)↔GO L
L3: CAME 2,4↔ GO DIE↔ DAP E,5(Q)↔GO L
DIE: FATAL(NAME)
L: GETAC(6)
RET2
LIT
BEND}
WING.(NCW., N,N,P,DIP,DAP)
WING.(PCW., P,P,N,DAP,DIP)
WING.(NCCW.,N,P,P,DIP,DAP)
WING.(PCCW.,P,N,N,DAP,DIP)
; ORIENTED WING FETCH OPERATIONS.
; E ← ECW(E,X);
; E ← ECCW(E,X);
; Q ← OTHER(E,X);
DEFINE OWING (NAME,PCW,NCW,NCCW,PCCW) {
SUBR(NAME)
BEGIN NAME
Q←1 ↔ X←2 ↔ E←3
DAC 2,AC2↔ DAC 3,AC3
CDR X,ARG1↔CDR E,ARG2
TEST X,VBIT
GO[
PFACE Q,E↔CAME Q,X↔GO L1↔ PCW Q,E↔GO L
L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L]
PVT Q,E↔CAME Q,X↔GO L2↔ NCCW Q,E↔GO L
L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PCCW Q,E↔GO L
DIE: FATAL(NAME)
L: LAC 2,AC2↔ LAC 3,AC3↔ RET2
LIT
BEND}
OWING(ECW, PCW, NCW, NCCW,PCCW)
OWING(ECCW, PCCW, NCCW, PCW, NCW)
OWING(OTHER,NFACE,PFACE,NVT, PVT)
; ORIENTED WING FETCH OPERATIONS.
; ECW.(Q,E,X);
; ECCW.(Q,E,X);
; OTHER.(Q,E,X);
DEFINE OWING. $(NAME,PCW,NCW,NCCW,PCCW) {
SUBR(NAME)
BEGIN NAME
Q←0 ↔ E←X←1
CDR X,ARG1↔TEST X,VBIT
GO[
CDR E,ARG2
PFACE Q,E↔CAME Q,ARG1↔GO L1
POP P,-1(P)↔GO PCW$.
L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE
POP P,-1(P)↔GO NCW$.]
CDR E,ARG2
NVT Q,E↔CAME Q,ARG1↔GO L2
POP P,-1(P)↔GO NCCW$.
L2: PVT Q,E↔CAME Q,ARG1↔GO DIE
POP P,-1(P)↔GO PCCW$.
DIE: FATAL(NAME)
LIT
BEND}
OWING.(ECW., PCW, NCW, NCCW,PCCW)
OWING.(ECCW., PCCW,NCCW,PCW, NCW)
; OTHER.(Q,E,X)
SUBR(OTHER.)
BEGIN OTHER.
Q←1↔ X←2↔ E←3
DAC AC0↔DAC 1,AC1↔DAC 2,AC2↔DAC 3,AC3
CDR X,ARG1↔ CDR E,ARG2↔ CDR Q,ARG3
TEST X,VBIT
GO[
PFACE 0,E↔ CAME X↔ GO L1↔ NFACE. Q,E↔GO L
L1: NFACE 0,E↔ CAME X↔ GO DIE↔PFACE. Q,E↔GO L]
NVT 0,E↔ CAME X↔ GO L2↔ PVT. Q,E↔GO L
L2: PVT 0,E↔ CAME X↔ GO DIE↔NVT. Q,E↔GO L
DIE: FATAL(OTHER.)
L: LAC AC0↔LAC 1,AC1↔LAC 2,AC2↔LAC 3,AC3↔RET3
LIT
BEND
; BODY FETCHER - GET THE BODY OF Q.
; B ← BODY(Q).
SUBR(BODI)
SUBR(BODY)
BEGIN BODY
Q←1
CDR Q,ARG1
TESTZ Q,BBIT
RET1 ;Q'S ALREADY A BODY.
TESTZ Q,EBIT
L1: GO [PBODY Q,Q↔RET1] ;Q WAS AN EDGE.
TESTZ Q,FBIT
GO [PFACE 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;FACE
TESTZ Q,VBIT
GO [PVT 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;VERTEX
RET1; Q AIN'T GOT NO BODY.
L2: RET1(0) ;VERTEX BODY CASE.
LIT
BEND
; ORIENTED VERTEX-FACE FETCH WRT AN EDGE.
; V ← VCW(E,F);
; V ← VCCW(E,F);
; F ← FCW(E,V);
; F ← FCCW(E,V);
DEFINE VFETCH $(NAME,FACE,VT,PP,NN){
SUBR(NAME)
BEGIN NAME
Q←1 ↔ E←2
DAC 2,AC2
CDR E,ARG2
P$FACE Q,E↔CAME Q,ARG1↔GO L1 ↔PP$VT Q,E↔GO L
L1: N$FACE Q,E↔CAME Q,ARG1↔GO DIE↔NN$VT Q,E↔GO L
DIE: FATAL(NAME)
L: LAC 2,AC2↔RET2↔LIT
BEND}
VFETCH (VCW,FACE,VT,P,N)
VFETCH (VCCW,FACE,VT,N,P)
VFETCH (FCW,VT,FACE,N,P)
VFETCH (FCCW,VT,FACE,P,N)
SUBR(MKLOCOR)
BEGIN MKLOCOR
PUSH P,[4+9];LOCOR SIZE.
PUSHJ P,GETBLK
ADDI 1,3
SLIMZ(<1.0>)
DAC IX(1)
DAC JY(1)
DAC KZ(1)
RET0
BEND
;BLIT(TO,FROM,SIZE)
SUBR(BLIT)
BEGIN BLIT
CDR ARG3↔LAC 1,
SLAP ARG2↔ADD 1,ARG1
BLT -1(1)↔RET3
BEND
;FETCH THE SUPRA-PART OF A BODY.
SUBR(SUPART)
BEGIN SUPART
B←1
CDR B,ARG1
COPART B,B
JUMPGE B,.-1
MOVMS B
RET1
BEND
;ATTACH B1 TO B2, B1 BECOMES A SUBPART OF B2.
;ATTACH(B1,B2) PRIMITIVE
SUBR(ATT)
BEGIN ATT
B←1
ACCUMULATORS{B1,B2}
CDR B1,ARG2
CDR B2,ARG1
PART B,B2
COPAR. B,B1
PART. B1,B2
PCNT 0,B2↔AOS↔PCNT. 0,B2
RET2
BEND
;DETACH(B) PRIMITIVE
SUBR(DET)
BEGIN DET
B1←1 ↔ B←2
PUSH P,ARG1
PUSHJ P,SUPART
PCNT 0,1↔SOS↔PCNT. 0,1
CDR B,ARG1 ;ME.
PART 0,B1
CAMN 0,B↔GO[COPART 0,B↔PART. 0,B1↔RET1]
LAC B1,0
COPART 0,B1
CAME 0,B↔GO[LAC B1,0↔GO .-2]
COPART 0,B
COPAR. 0,B1 ;HE POINTS WHERE I USE TO POINT.
RET1
BEND
;ATTACH(B1,B2) COMMAND.
SUBR(ATTACH)
BEGIN ATTACH
LAC 2,ARG1↔TEST 2,BBIT↔RET2
LAC 2,ARG2↔TEST 2,BBIT↔RET2
PUSH P,ARG2
PUSHJ P,DET
GO ATT
BEND
;DETACH(B) COMMAND.
SUBR(DETACH)
BEGIN DETACH
LAC 2,ARG1↔TEST 2,BBIT↔RET1
PUSH P,ARG1
PUSHJ P,DET
POP P,0 ;MY RETURN ADDRESS.
PUSH P,WORLD
PUSH P,0 ;KIND OF A PUSHJ.
GO ATT
BEND
END